home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / prlgbnch.lha / poly_10.pl < prev    next >
Text File  |  1990-05-25  |  3KB  |  102 lines
  1. % generated: 8 March 1990
  2. % option(s): NO_TERM_COMPARE
  3. %
  4. %   (poly) poly_10
  5. %
  6. %   Ralph Haygood (based on Prolog version by Rick McGeer
  7. %                  based on Lisp version by R. P. Gabriel)
  8. %
  9. %   raise a polynomial (1+x+y+z) to the 10th power (symbolically)
  10.  
  11. :-op(700,xfx,less_than).
  12.  
  13. poly_10 :- test_poly(P), poly_exp(10, P, _).
  14.  
  15. % test polynomial definition
  16.  
  17. test_poly(P) :-
  18.     poly_add(poly(x,[term(0,1),term(1,1)]),poly(y,[term(1,1)]),Q),
  19.     poly_add(poly(z,[term(1,1)]),Q,P).
  20.  
  21. % 'less_than'/2 for x, y, z
  22.  
  23. x less_than y.
  24. y less_than z.
  25. x less_than z.
  26.  
  27. % polynomial addition
  28.  
  29. poly_add(poly(Var,Terms1), poly(Var,Terms2), poly(Var,Terms)) :- !,
  30.     term_add(Terms1, Terms2, Terms).
  31. poly_add(poly(Var1,Terms1), poly(Var2,Terms2), poly(Var1,Terms)) :-
  32.     Var1 less_than Var2, !,
  33.     add_to_order_zero_term(Terms1, poly(Var2,Terms2), Terms).
  34. poly_add(Poly, poly(Var,Terms2), poly(Var,Terms)) :- !,
  35.     add_to_order_zero_term(Terms2, Poly, Terms).
  36. poly_add(poly(Var,Terms1), C, poly(Var,Terms)) :- !,
  37.     add_to_order_zero_term(Terms1, C, Terms).
  38. poly_add(C1, C2, C) :-
  39.     C is C1+C2.
  40.  
  41. % term addition
  42.  
  43. term_add([], X, X) :- !.
  44. term_add(X, [], X) :- !.
  45. term_add([term(E,C1)|Terms1], [term(E,C2)|Terms2], [term(E,C)|Terms]) :- !,
  46.     poly_add(C1, C2, C),
  47.     term_add(Terms1, Terms2, Terms).
  48. term_add([term(E1,C1)|Terms1], [term(E2,C2)|Terms2], [term(E1,C1)|Terms]) :-
  49.     E1 < E2, !,
  50.     term_add(Terms1, [term(E2,C2)|Terms2], Terms).
  51. term_add(Terms1, [term(E2,C2)|Terms2], [term(E2,C2)|Terms]) :-
  52.     term_add(Terms1, Terms2, Terms).
  53.  
  54. add_to_order_zero_term([term(0,C1)|Terms], C2, [term(0,C)|Terms]) :- !,
  55.     poly_add(C1, C2, C).
  56. add_to_order_zero_term(Terms, C, [term(0,C)|Terms]).
  57.  
  58. % polynomial exponentiation
  59.  
  60. poly_exp(0, _, 1) :- !.
  61. poly_exp(N, Poly, Result) :-
  62.     M is N>>1,
  63.     N is M<<1, !,
  64.     poly_exp(M, Poly, Part),
  65.     poly_mul(Part, Part, Result).
  66. poly_exp(N, Poly, Result) :-
  67.     M is N-1,
  68.     poly_exp(M, Poly, Part),
  69.     poly_mul(Poly, Part, Result).
  70.  
  71. % polynomial multiplication
  72.  
  73. poly_mul(poly(Var,Terms1), poly(Var,Terms2), poly(Var,Terms)) :- !,
  74.     term_mul(Terms1, Terms2, Terms).
  75. poly_mul(poly(Var1,Terms1), poly(Var2,Terms2), poly(Var1,Terms)) :-
  76.     Var1 less_than Var2, !,
  77.     mul_through(Terms1, poly(Var2,Terms2), Terms).
  78. poly_mul(P, poly(Var,Terms2), poly(Var,Terms)) :- !,
  79.     mul_through(Terms2, P, Terms).
  80. poly_mul(poly(Var,Terms1), C, poly(Var,Terms)) :- !,
  81.     mul_through(Terms1, C, Terms).
  82. poly_mul(C1, C2, C) :-
  83.     C is C1*C2.
  84.  
  85. term_mul([], _, []) :- !.
  86. term_mul(_, [], []) :- !.
  87. term_mul([Term|Terms1], Terms2, Terms) :-
  88.     single_term_mul(Terms2, Term, PartA),
  89.     term_mul(Terms1, Terms2, PartB),
  90.     term_add(PartA, PartB, Terms).
  91.  
  92. single_term_mul([], _, []) :- !.
  93. single_term_mul([term(E1,C1)|Terms1], term(E2,C2), [term(E,C)|Terms]) :-
  94.     E is E1+E2,
  95.     poly_mul(C1, C2, C),
  96.     single_term_mul(Terms1, term(E2,C2), Terms).
  97.  
  98. mul_through([], _, []) :- !.
  99. mul_through([term(E,Term)|Terms], Poly, [term(E,NewTerm)|NewTerms]) :-
  100.     poly_mul(Term, Poly, NewTerm),
  101.     mul_through(Terms, Poly, NewTerms).
  102.